home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Filter.cls < prev    next >
Text File  |  1997-06-14  |  3KB  |  127 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "GFilter"
  6. Attribute VB_GlobalNameSpace = True
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorFilter
  13.     eeBaseFilter = 13490    ' Filter
  14. End Enum
  15.  
  16. Sub FilterTextFile(filter As IFilter)
  17.     
  18.     BugAssert filter.Source <> sEmpty
  19.     ' Target can be another file or replacement of current file
  20.     Dim sTarget As String, fReplace As Boolean
  21.     sTarget = filter.Target
  22.     If sTarget = sEmpty Or sTarget = filter.Source Then
  23.         sTarget = MUtility.GetTempFile("FLT", ".")
  24.         fReplace = True
  25.     End If
  26.     
  27.     ' Open input file
  28.     On Error GoTo FilterTextError1
  29.     Dim nIn As Integer, nOut As Integer
  30.     nIn = FreeFile
  31.     Open filter.Source For Input Access Read Lock Write As #nIn
  32.  
  33.     ' Open target output file
  34.     On Error GoTo FilterTextError2
  35.     nOut = FreeFile
  36.     Open sTarget For Output Access Write Lock Read Write As #nOut
  37.  
  38.     ' Filter each line
  39.     On Error GoTo FilterTextError3
  40.     Dim sLine As String, iLine As Long, eca As EChunkAction
  41.     Do Until EOF(nIn)
  42.         Line Input #nIn, sLine
  43.         iLine = iLine + 1
  44.         eca = filter.Translate(sLine, iLine)
  45.         Select Case eca
  46.         Case ecaAbort
  47.             GoTo FilterTextError3   ' Stop processing
  48.         Case ecaTranslate
  49.             Print #nOut, sLine      ' Write modified line to output
  50.         Case ecaSkip
  51.                                     ' Ignore
  52.         Case Else
  53.             BugAssert True          ' Should never happen
  54.         End Select
  55.     Loop
  56.     
  57.     ' Close files
  58.     On Error GoTo FilterTextError1
  59.     Close nIn
  60.     Close nOut
  61.     If fReplace Then
  62.         ' Destroy old file and replace it with new one
  63.         Kill filter.Source
  64.         On Error Resume Next   ' No more errors allowed
  65.         Name sTarget As filter.Source
  66.         ' If this fails, you're in trouble
  67.         BugAssert Err = 0
  68.     End If
  69.     Exit Sub
  70.         
  71. FilterTextError3:
  72.     Close nOut
  73. FilterTextError2:
  74.     Close nIn
  75. FilterTextError1:
  76.     MErrors.ErrRaise Err
  77. End Sub
  78. '
  79.  
  80.  
  81. ' Applies filter to the IFilter.Source string and
  82. ' and saves the result in the IFilter.Target string.
  83. Sub FilterText(filter As IFilter)
  84.     Dim sSrc As String, sDst As String
  85.     Dim iLine As Integer, sLine As String
  86.     
  87.     sSrc = filter.Source
  88.     sLine = MUtility.GetNextLine(sSrc)
  89.     Do While sLine <> sEmpty
  90.         ' Strip off sCrLf
  91.         sLine = MUtility.RTrimLine(sLine)
  92.         iLine = iLine + 1
  93.         Select Case filter.Translate(sLine, iLine)
  94.         Case ecaAbort:
  95.             Exit Sub
  96.         Case ecaTranslate:
  97.             sDst = sDst & sLine & sCrLf
  98.         Case ecaSkip:
  99.         Case Else:
  100.             BugAssert True
  101.         End Select
  102.         sLine = MUtility.GetNextLine
  103.     Loop
  104.     filter.Target = sDst
  105. End Sub
  106.  
  107. #If fComponent = 0 Then
  108. Private Sub ErrRaise(e As Long)
  109.     Dim sText As String, sSource As String
  110.     If e > 1000 Then
  111.         sSource = App.ExeName & ".Filter"
  112.         Select Case e
  113.         Case eeBaseFilter
  114.             BugAssert True
  115.        ' Case ee...
  116.        '     Add additional errors
  117.         End Select
  118.         Err.Raise COMError(e), sSource, sText
  119.     Else
  120.         ' Raise standard Visual Basic error
  121.         sSource = App.ExeName & ".VBError"
  122.         Err.Raise e, sSource
  123.     End If
  124. End Sub
  125. #End If
  126.  
  127.